home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 4 / Apprentice-Release4.iso / Source Code / By the Book / Mac Pascal Primer, 4.0 / Chap 3, Mondrian ƒ / Mondrian.p next >
Encoding:
Text File  |  1990-07-30  |  1.6 KB  |  79 lines  |  [TEXT/PJMM]
  1. program Mondrian;
  2.     const
  3.         BASE_RES_ID = 400;
  4.  
  5.     var
  6.         gDrawWindow: WindowPtr;
  7.         gFillColor: LONGINT;
  8.  
  9.  
  10. {-------------------------------->    Randomize    <---}
  11.  
  12.     function Randomize (range: INTEGER): INTEGER;
  13.         var
  14.             rawResult: LONGINT;
  15.     begin
  16.         rawResult := Random;
  17.         rawResult := abs(rawResult);
  18.  
  19.         Randomize := (rawResult * range) div 32768;
  20.     end;
  21.  
  22.  
  23. {-------------------------------->    RandomRect    <---}
  24.  
  25.     procedure RandomRect (var myRect: Rect; boundingWindow: WindowPtr);
  26.     begin
  27.         myRect.left := Randomize(boundingWindow^.portRect.right - boundingWindow^.portRect.left);
  28.         myRect.right := Randomize(boundingWindow^.portRect.right - boundingWindow^.portRect.left);
  29.         myRect.top := Randomize(boundingWindow^.portRect.bottom - boundingWindow^.portRect.top);
  30.         myRect.bottom := Randomize(boundingWindow^.portRect.bottom - boundingWindow^.portRect.top);
  31.     end;
  32.  
  33.  
  34. {-------------------------------->    DrawRandomRect    <---}
  35.  
  36.     procedure DrawRandomRect;
  37.         var
  38.             myRect: Rect;
  39.     begin
  40.         RandomRect(myRect, gDrawWindow);
  41.         ForeColor(gFillColor);
  42.         PaintOval(myRect);
  43.     end;
  44.  
  45.  
  46. {-------------------------------->    MainLoop    <---}
  47.  
  48.     procedure MainLoop;
  49.     begin
  50.         GetDateTime(randSeed);
  51.         gFillColor := blackColor;
  52.  
  53.         while (not Button) do
  54.             begin
  55.                 DrawRandomRect;
  56.                 if (gFillColor = blackColor) then
  57.                     gFillColor := whiteColor
  58.                 else
  59.                     gFillColor := blackColor
  60.             end;
  61.     end;
  62.  
  63.  
  64. {-------------------------------->    WindowInit    <---}
  65.  
  66.     procedure WindowInit;
  67.     begin
  68.         gDrawWindow := GetNewWindow(BASE_RES_ID, nil, WindowPtr(-1));
  69.         ShowWindow(gDrawWindow);
  70.         SetPort(gDrawWindow);
  71.     end;
  72.  
  73.  
  74. {-------------------------------->    Mondrian    <---}
  75.  
  76. begin
  77.     WindowInit;
  78.     MainLoop;
  79. end.